home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-13
/
pasledit.zip
/
EDITOR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-17
|
16KB
|
459 lines
(*
Simple line editor program. Written in Standard Pascal.
By Ilya Shlyakhter, D-block
*)
PROGRAM LineEditor (Input, Output);
USES Strings;
CONST NameCount = 10;
MaxNameLength = 30;
TYPE NameArray = ARRAY [1..NameCount] OF StrType;
NameCountType = 0..NameCount;
NameLengthType = 0..MaxNameLength;
Digit = 0..9;
VAR NameData: NameArray;
FUNCTION UpCaseChar (Ch: Char): Char;
(*
Converts a character to uppercase.
*)
BEGIN (* UpCaseChar *)
IF Ch IN ['a'..'z'] THEN
Ch := Chr (Ord (Ch) - Ord ('a') + Ord ('A'));
UpCaseChar := Ch
END; (* UpCaseChar *)
FUNCTION ChrDigit (Ch: Char): Digit;
BEGIN (* ChrDigit *)
ChrDigit := Ord (Ch) - Ord ('0')
END; (* ChrDigit *)
PROCEDURE FlushLine;
VAR Ch: Char;
BEGIN (* FlushLine *)
WHILE NOT (Eof OR Eoln) DO
Read (Ch);
ReadLn
END; (* FlushLine *)
PROCEDURE ReadNames (VAR Names: NameArray);
VAR CurrentNameNum: NameCountType;
PROCEDURE InputName (VAR Name: StrType);
VAR CurrentCharNum: NameLengthType;
Ch: Char;
BEGIN (* InputName *)
StrInit (Name);
CurrentCharNum := 1;
WHILE NOT Eof AND NOT Eoln AND (CurrentCharNum <= MaxnameLength) DO
BEGIN (* read name *)
Read (Ch);
StrAddChar (Name, Ch);
CurrentCharNum := CurrentCharNum + 1
END; (* read name *)
ReadLn
END; (* InputName *)
BEGIN (* ReadNames *)
FOR CurrentNameNum := 1 TO NameCount DO
BEGIN (* read *)
WriteLn;
Write ('Please enter name #',CurrentNameNum,': ');
InputName (Names [CurrentnameNum])
END; (* read *)
END; (* ReadNames *)
PROCEDURE DisplayNames (Names: NameArray);
VAR I: Integer;
BEGIN (* DisplayNames *)
WriteLn;
WriteLn ('You have entered the following names:');
WriteLn;
FOR I := 1 TO NameCount DO
BEGIN
Write (I,' - ');
StrDisplayString (Names [I])
END;
WriteLn;
END; (* DisplayNames *)
PROCEDURE ProcessNames (Names: NameArray);
VAR NameNum: NameCountType;
Done: Boolean;
PROCEDURE EditString (VAR TheString: StrType);
VAR Done: Boolean;
Ch: Char;
PROCEDURE DisplayHelp;
VAR Ch: Char;
BEGIN (* DisplayHelp *)
FlushLine;
WriteLn;
WriteLn (' EDITOR COMMANDS ');
WriteLn (' ');
WriteLn (' Icn Insert character c at position n ');
WriteLn (' ');
WriteLn (' DPn Delete character at POSITION n ');
WriteLn (' DFc Delete FIRST occurence of the character c ');
WriteLn (' ');
WriteLn (' RPcn Replace the character at POSITION n with character c ');
WriteLn (' RFcd Replace the FIRST occurence of character c with character d ');
WriteLn (' RAcd Replace ALL occurences of character c with character d ');
WriteLn (' ');
WriteLn (' H, ? Display this help screeen ');
WriteLn (' Q Quit ');
END; (* DisplayHelp *)
PROCEDURE ReadPos (VAR Value: StrLengthType; VAR Error: Boolean);
VAR Ch: Char;
CurrentValue: Integer;
Digits: SET OF Char;
Factor: Integer;
MaxFactor: Integer;
BEGIN (* ReadPos *)
Digits := ['0'..'9'];
Error := False;
IF Eof OR Eoln THEN
Error := True
ELSE
BEGIN (* there is text to read *)
CurrentValue := 0;
Factor := 1;
MaxFactor := 1;
WHILE (MaxStrLength DIV MaxFactor) > 0 DO
MaxFactor := MaxFactor * 10;
WHILE NOT (Eof OR Eoln OR Error OR (Factor > MaxFactor)) DO
BEGIN (* process number *)
Read (Ch);
IF Ch IN Digits THEN
CurrentValue := CurrentValue + ChrDigit (Ch) * Factor
ELSE
Error := True
END; (* process number *)
END; (* there is text to read *)
IF NOT Error THEN
Value := CurrentValue
END; (* ReadPos *)
PROCEDURE ReportError;
VAR Ch: Char;
BEGIN (* ReportError *)
FlushLine;
WriteLn;
WriteLn ('Input error. Try again.');
WriteLn
END; (* ReportError *)
PROCEDURE ProcessDelete;
VAR Ch: Char;
PROCEDURE ProcessDelPos;
VAR Position: StrLengthType;
Error: Boolean;
BEGIN (* ProcessDelPos *)
ReadPos (Position, Error);
IF Error THEN
ReportError
ELSE
BEGIN
StrDeleteCharPos (TheString, Position);
FlushLine
END
END; (* ProcessDelPos *)
PROCEDURE ProcessDelFirst;
VAR Position: StrLengthType;
Ch: Char;
BEGIN (* ProcessDelFirst *)
IF NOT (Eof OR Eoln) THEN
BEGIN (* process parameter *)
Read (Ch);
StrDeleteCharFirst (TheString, Ch);
FlushLine
END (* process parameter *)
ELSE
ReportError;
END; (* ProcessDelFirst *)
BEGIN (* ProcessDelete *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN
Read (Ch); (* read Delete subfunction *)
CASE UpCaseChar (Ch) OF
'P': ProcessDelPos;
'F': ProcessDelFirst;
ELSE
ReportError
END (* case *)
END;
END; (* ProcessDelete *)
PROCEDURE ProcessInsert;
VAR Position: StrLengthType;
VAR Ch: Char;
Error: Boolean;
BEGIN (* ProcessInsert *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* at least 1 parameter given *)
Read (Ch);
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* read position *)
ReadPos (Position, Error);
IF Error THEN
ReportError
ELSE
BEGIN (* everything ok *)
StrInsertChar (TheString, Ch, Position);
FlushLine
END (* everything ok *)
END; (* read position *)
END; (* at least 1 parameter given *)
END; (* ProcessInsert *)
PROCEDURE ProcessReplace;
VAR ReplaceType: Char;
PROCEDURE ProcessReplacePos;
VAR Ch: Char;
Position: StrLengthType;
Error: Boolean;
BEGIN (* ProcessReplacePos *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* at least 1 parameter given *)
Read (Ch);
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* at least 2 parameters given *)
ReadPos (Position, Error);
IF Error THEN
ReportError
ELSE
BEGIN (* everything ok *)
StrReplaceCharPos (TheString, Ch, Position);
FlushLine
END (* everything ok *)
END; (* at least 2 parameters given *)
END; (* at least 1 parameter given *)
END; (* ProcessReplacePos *)
PROCEDURE ProcessReplaceFirst;
VAR OldChar, NewChar: Char;
BEGIN (* ProcessReplaceFirst *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* source character given *)
Read (OldChar);
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* target character given *)
Read (NewChar);
StrReplaceCharFirst (TheString, OldChar, NewChar);
FlushLine
END (* target character given *)
END; (* source character given *)
END; (* ProcessReplaceFirst *)
PROCEDURE ProcessReplaceAll;
VAR OldChar, NewChar: Char;
BEGIN (* ProcessReplaceAll *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* source character given *)
Read (OldChar);
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* target character given *)
Read (NewChar);
StrReplaceCharAll (TheString, OldChar, NewChar);
FlushLine
END (* target character given *)
END; (* source character given *)
END; (* ProcessReplaceAll *)
BEGIN (* ProcessReplace *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* there is more input to read *)
Read (ReplaceType);
CASE UpCaseChar (ReplaceType) OF
'P': ProcessReplacePos;
'F': ProcessReplaceFirst;
'A': ProcessReplaceAll
ELSE
ReportError;
END; (* case *)
END; (* there is more input to read *)
END; (* ProcessReplace *)
PROCEDURE ProcessAppend;
VAR Ch: Char;
BEGIN (* ProcessAppend *)
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* process parameter *)
Read (Ch);
StrAddChar (TheString, Ch);
FlushLine
END; (* process parameter *)
END; (* ProcessAppend *)
BEGIN (* EditString *)
WriteLn;
Done := False;
WHILE NOT Done DO
BEGIN (* edit string *)
WriteLn;
StrDisplayString (TheString);
WriteLn ('The name is now ',StrLength (TheString),' characters long.');
WriteLn;
Write ('Enter command: ');
IF Eof OR Eoln THEN
ReportError
ELSE
BEGIN (* the user entered something *)
Read (Ch);
CASE UpCaseChar (Ch) OF
'D': ProcessDelete;
'I': ProcessInsert;
'R': ProcessReplace;
'A': ProcessAppend;
'H': DisplayHelp;
'Q': Done := True
END; (* case *)
END; (* the user entered something *)
END; (* edit string *)
END; (* EditString *)
BEGIN (* ProcessNames *)
Done := False;
REPEAT
REPEAT
WriteLn;
Write ('Enter the number of name to revise (1 through ',NameCount,', 0 to quit): ');
ReadLn (NameNum);
UNTIL NameNum <= NameCount;
IF NameNum = 0 THEN
Done := True
ELSE
EditString (Names [NameNum])
UNTIL Done;
WriteLn
END; (* ProcessNames *)
BEGIN (* LineEditor *)
ReadNames (NameData);
DisplayNames (NameData);
ProcessNames (NameData)
END. (* LineEditor *)
